home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
prolog_2.zip
/
GAMES.ZIP
/
CHESSKRK.PRO
next >
Wrap
Text File
|
1986-11-01
|
13KB
|
499 lines
/* King - Rook - King endgame. Adapted from: */
"Prolog Programming for Artificial Intelligence" */
/* by Ivan Bratko (pp 370-386) */
/* The name of the contributor will remain confidential for */
/* now. */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* A miniature implementation of Advice Language 0 */
/* This program plays a game from a given starting position */
/* using knowledge represented in Advice Language 0 */
?- op(200,xfy,': ').
?- op(220,xfy,'.. ').
?- op(185,fx,'if ').
?- op(190,xfx,'then ').
?- op(180,xfy,'or ').
?- op(160,xfy,'and ').
/* ?- op(140,fx,'not '). */
it(X) :- X = (w .. 4 : 5 .. 5 : 3 .. 3 : 7 .. 0).
/* Play a game starting in Pos */
/* Start with empty forcing-tree */
play(Pos) :-
playgame(Pos,nil).
playgame(Pos,ForcingTree) :-
show(Pos),
(end_of_game(Pos),
print('End of game'), nl,!;
playmove(Pos,ForcingTree,Pos1,ForcingTree1), !,
playgame(Pos1,ForcingTree1) ).
/* Play 'us' move according to forcing-tree. */
playmove(Pos,Move .. FTree1,Pos1,FTree1) :-
side(Pos,w),
legalmove(Pos,Move,Pos1),
showmove(Move).
/* Read 'them' move. */
playmove(Pos,FTree,Pos1,FTree1) :-
side(Pos,b),
print('Your move: '),
read(Move),
(legalmove(Pos,Move,Pos1),
subtree(FTree,Move,FTree1), ! ;
print('Illegal move '), nl,
playmove(Pos,FTree,Pos1,FTree1) ).
/* If current forcing-tree is empty, generate a new one. */
playmove(Pos,nil,Pos1,FTree1) :-
side(Pos,w),
resetdepth(Pos,Pos0),
strategy(Pos0,FTree), !,
playmove(Pos0,FTree,Pos1,FTree1).
/* Select a forcing-subtree corresponding to Move. */
subtree(FTrees,Move,FTree) :-
member(Move .. FTree,FTrees), !.
subtree(_,_,nil).
strategy(Pos,ForcingTree) :-
Rule : if Condition then AdviceList,
holds(Condition,Pos,_), !,
member(AdviceName,AdviceList),
nl, print('Trying '), print(AdviceName),
satisfiable(AdviceName,Pos,ForcingTree), !.
satisfiable(AdviceName,Pos,FTree) :-
advice(AdviceName,Advice),
sat(Advice,Pos,Pos,FTree).
sat(Advice,Pos,RootPos,FTree) :-
holdinggoal(Advice,HG),
holds(HG,Pos,RootPos),
sat1(Advice,Pos,RootPos,FTree).
sat1(Advice,Pos,RootPos,nil) :-
bettergoal(Advice,BG),
holds(BG,Pos,RootPos), !.
sat1(Advice,Pos,RootPos,Move .. FTrees) :-
side(Pos,w), !,
usmoveconstr(Advice,UMC),
move(UMC,Pos,Move,Pos1),
sat(Advice,Pos1,RootPos,FTrees).
sat1(Advice,Pos,RootPos,FTrees) :-
side(Pos,b), !,
themmoveconstr(Advice,TMC),
findall(Move .. Pos1,move(TMC,Pos,Move,Pos1), MPlist),
unique([],MPlist,MPlist1),
not(empty(MPlist1)),
satall(Advice,MPlist1,RootPos,FTrees).
satall(_,[],_,[]).
satall(Advice,[Move .. Pos|MPlist],RootPos,[Move .. FT|MFTs]) :-
sat(Advice,Pos,RootPos,FT),
satall(Advice,MPlist,RootPos,MFTs).
/* Interpreting holding and bettergoals: */
/* A goal is an AND/OR/NOT combination of predicate names. */
holds(Goal1 and Goal2, Pos,RootPos) :-
!,
holds(Goal1,Pos,RootPos),
holds(Goal2,Pos,RootPos).
holds(Goal1 or Goal2,Pos,RootPos) :-
!,
(holds(Goal1,Pos,RootPos) ;
holds(Goal2,Pos,RootPos) ).
holds(not(Goal),Pos,RootPos) :-
!,
not(holds(Goal,Pos,RootPos)).
holds(Pred,Pos,RootPos) :-
Pred(Pos) ;
Pred(Pos,RootPos).
/* Interpreting move constraints. */
move(MC1 and MC2,Pos,Move,Pos1) :-
!,
move(MC1,Pos,Move,Pos1),
move(MC2,Pos,Move,Pos1).
move(MC1 then MC2,Pos,Move,Pos1) :-
!,
(move(MC1,Pos,Move,Pos1) ;
move(MC2,Pos,Move,Pos1) ).
/* Selectors for components of piece-of-advice. */
bettergoal(BG : _,BG).
holdinggoal(BG : HG : _,HG).
usmoveconstr(BG : HG : UMC : _,UMC).
themmoveconstr(BG : HG : UMC : TMC, TMC).
next([],L,L).
next([X|L1],L2,[X|L3]) :- next(L1,L2,L3).
findall(X,Goal,Xlist) :-
Goal,
assertz(stack(X)),
fail.
findall(X,Goal,Xlist) :-
assertz(stack(bottom)),
collect(Xlist).
collect(L) :-
retract(stack(X)), !,
collect1(L,X).
collect1([],X) :-
X == bottom, !.
collect1(L,X) :-
L = [X|Rest],
collect(Rest).
unique([],X,X).
unique([H|T],L,X) :-
not(member(H,L)),
unique(T,[H|L],X).
unique([H|T],L,X) :-
member(H,L),
unique(T,L,X).
empty([]).
/* King & Rook vs. King in Advice Language 0. */
/* Rules */
edge_rule : if their_king_edge and kings_close
then [ mate_in_2, squeeze, approach, keeproom,
divide_in_2, divide_in_3 ].
else_rule : if true
then [ squeeze, approach, keeproom,
divide_in_2, divide_in_3 ].
/* Pieces-of-advice. */
advice(mate_in_2,
mate :
not(rooklost) and their_king_edge :
( depth = 0 ) and legal then ( depth = 2 ) and checkmove :
(depth = 1 ) and legal ).
advice(squeeze,
newroomsmaller and not(rookexposed) and
rookdivides and not(stalemate) :
not(rooklost) :
( depth = 0 ) and rookmove :
nomove ).
advice( approach,
okapproachedcsquare and not(rookexposed) and
( rookdivides or lpatt ) and ( roomgt2 or not(our_king_edge)) :
not(rooklost) :
( depth = 0 ) and kingdiagfirst :
nomove ).
advice( keeproom,
themtomove and not(rookexposed) and rookdivides and okorndle and
( roomgt2 or not(our_king_edge) ) :
not(rooklost) :
( depth = 0 ) and kingdiagfirst :
nomove ).
advice( divide_in_2,
themtomove and rookdivides and not(rookexposed) :
not(rooklost) :
( depth < 3 ) and legal :
( depth < 2 ) and legal ).
advice( divide_in_3,
themtomove and rookdivides and not(rookexposed) :
not(rooklost) :
( depth < 5 ) and legal :
( depth < 4 ) and legal ).
/* Predicate library for King & Rook vs. King. */
/* Position is represented by : */
/* Side .. Wx : Wy .. Rx : Ry .. Bx : By .. Depth */
/* */
/* Side is side to move ('w' or 'b'). */
/* Wx, Wy are X- and Y-coordinates of White King. */
/* Rx, Ry are X- and Y-coordinates of White Rook. */
/* Bx, By are X- and Y-coordinates of Black King. */
/* Depth is depth of position in search tree. */
/* */
/* Selector relations. */
side(Side .. _,Side).
wk(_ .. WK .. _, WK).
wr(_ .. _ .. WR .. _, WR).
bk(_ .. _ .. _ .. BK .. _, BK).
depth(_ .. _ .. _ .. _ .. Depth, Depth).
resetdepth(S .. W .. R .. B .. D,S .. W .. R .. B .. 0).
/* Some relations between squares. */
n(N,N1) :-
(N1 is N + 1 ;
N1 is N - 1),
in(N1).
in(N) :-
N > 0,
N < 9.
diagngb(X : Y,X1 : Y1) :-
n(X,X1),
n(Y,Y1).
verngb(X : Y,X : Y1) :-
n(Y,Y1).
horngb(X : Y,X1 : Y) :-
n(X,X1).
ngb(S,S1) :-
diagngb(S,S1) ;
horngb(S,S1) ;
verngb(S,S1).
end_of_game(Pos) :-
mate(Pos).
/* Move-constraints predicates. */
/* These are specialized move generators : */
/* move(MoveConstr,Pos,Move,NewPos) */
/* */
move(depth < Max, Pos,Move,Pos1) :-
depth(Pos,D),
D < Max, !.
move(depth = D, Pos,Move,Pos1) :-
depth(Pos,D), !.
move(kingdiagfirst,w .. W .. R .. B .. D,W-W1,b .. W1 .. R .. B .. D1) :-
D1 is D + 1,
ngb(W,W1),
not(ngb(W1,B)),
W1 \== R.
move(rookmove,w .. W .. Rx : Ry .. B .. D,(Rx : Ry)-R,b .. W .. R .. B .. D1) :-
D1 is D + 1,
coord(I),
(R = (Rx : I) ; R = (I : Ry) ),
R \== (Rx : Ry),
not(inway(Rx : Ry,W,R)).
move(checkmove,Pos,R-(Rx : Ry),Pos1) :-
wr(Pos,R),
bk(Pos,Bx : By),
(Rx = Bx ; Ry = By),
move(rookmove,Pos,R-(Rx : Ry),Pos1).
move(legal,w .. P,M,P1) :-
(MC = kingdiagfirst ; MC = rookmove),
move(MC,w .. P,M,P1).
move(legal,b .. W .. R .. B .. D,B-B1,w .. W .. R .. B1 .. D1) :-
D1 is D + 1,
ngb(B,B1),
not(check(w .. W .. R .. B1 .. D1)).
legalmove(Pos,Move,Pos1) :-
move(legal,Pos,Move,Pos1).
check(_ .. W .. Rx : Ry .. Bx : By .. _) :-
ngb(W,Bx : By) ;
(Rx = Bx ; Ry = By),
(Rx : Ry) \== (Bx : By),
not(inway(Rx : Ry,W,Bx : By)).
inway(S,S1,S1) :-
!.
inway(X1 : Y,X2 : Y,X3 : Y) :-
ordered(X1,X2,X3), !.
inway(X : Y1,X : Y2,X : Y3) :-
ordered(Y1,Y2,Y3).
ordered(N1,N2,N3) :-
N1 < N2, N2 < N3 ;
N3 < N2, N2 < N1.
coord(1).
coord(2).
coord(3).
coord(4).
coord(5).
coord(6).
coord(7).
coord(8).
/* Goal predicates. */
themtomove(b .. _).
mate(Pos) :-
side(Pos,b),
check(Pos),
not(legalmove(Pos,_,_)).
stalemate(Pos) :-
side(Pos,b),
not(check(Pos)),
not(legalmove(Pos,_,_)).
newroomsmaller(Pos,RootPos) :-
room(Pos,Room),
room(RootPos,RootRoom),
Room < RootRoom.
rookexposed(Side .. W .. R .. B .. _) :-
dist(W,R,D1),
dist(B,R,D2),
(Side = w, !, D1 > D2 + 1 ;
Side = b, !, D1 > D2 ).
okapproachedcsquare(Pos,RootPos) :-
okcsquaremdist(Pos,D1),
okcsquaremdist(RootPos,D2),
D1 < D2.
okcsquaremdist(Pos,Mdist) :-
wk(Pos,WK),
cs(Pos,CS),
manhdist(WK,CS,Mdist).
rookdivides(_ .. Wx : Wy .. Rx : Ry .. Bx : By .. _) :-
ordered(Wx,Rx,Bx), ! ;
ordered(Wy,Ry,By).
lpatt(_ .. W .. R .. B .. _) :-
manhdist(W,B,2),
manhdist(R,B,3).
okorndle(_ .. W .. R .. _,_ .. W1 .. R1 .. _) :-
dist(W,R,D),
dist(W1,R1,D1),
D =< D1.
roomgt2(Pos) :-
room(Pos,Room),
Room > 2.
our_king_edge(_ .. X : Y .. _) :-
(X = 1, ! ; X = 8, ! ; Y = 1, ! ; Y = 8).
their_king_edge((_ .. W .. R .. X : Y .. _)) :-
(X = 1, ! ; X = 8, ! ; Y = 1, ! ; Y = 8).
kings_close(Pos) :-
wk(Pos,WK),
bk(Pos,BK),
dist(WK,BK,D),
D < 4.
rooklost(_ .. W .. B .. B .. _).
rooklost(b .. W .. R .. B .. _) :-
ngb(B,R),
not(ngb(W,R)).
dist(X : Y,X1 : Y1,D) :-
absdiff(X,X1,Dx),
absdiff(Y,Y1,Dy),
max(Dx,Dy,D).
absdiff(A,B,D) :-
A > B, !,
D is A-B ;
D is B-A.
max(A,B,M) :-
A >= B, !,
M = A ;
M = B.
manhdist(X : Y,X1 : Y1,D) :-
absdiff(X,X1,Dx),
absdiff(Y,Y1,Dy),
D is Dx + Dy.
room(Pos,Room) :-
wr(Pos,Rx : Ry),
bk(Pos,Bx : By),
(Bx < Rx, SideX is Rx - 1 ; Bx > Rx, SideX is 8 - Rx),
(By < Ry, SideY is Ry - 1 ; By > Ry, SideY is 8 - Ry),
Room is SideX * SideY, ! ;
Room is 64.
cs(_ .. W .. Rx : Ry .. Bx : By .. _,Cx : Cy) :-
(Bx < Rx, !, Cx is Rx - 1 ; Cx is Rx + 1),
(By < Ry, !, Cy is Ry - 1 ; Cy is Ry + 1).
/* Display procedures. */
show(Pos) :-
nl,
coord(Y), nl,
coord(X),
writepiece(X : Y,Pos),
fail.
show(Pos) :-
side(Pos,S),
depth(Pos,D),
nl, print(' Side= '),
print(S),
print(' Depth= '),
print(D), nl.
writepiece(Square,Pos) :-
wk(Pos,Square), !, print(' W') ;
wr(Pos,Square), !, print(' R') ;
bk(Pos,Square), !, print(' B') ;
print(' .').
showmove(Move) :-
nl, print(Move), nl.